// System Unit
// Modular Support - DLL

(*************)
(* Interface *)
(*************)
{$IFDEF Include_Modules_Header}

 { Delayed load Support }
{
 Type
  PImageThunkData = ^TImageThunkData;
  TImageThunkData = Record
   Case Byte of
    0: (ForwarderString: LongWord); // PBYTE
    1: (&Function: LongWord);       // PLongWord Function -> _Function
    2: (Ordinal: LongWord);
    3: (AddressOfData: LongWord);   // PIMAGE_IMPORT_BY_NAME
  END;

  PImageDelayDescr = ^TImageDelayDescr;
  TImageDelayDescr = Record
   grAttrs:     LongWord;          // Attributes
   szName:      PAnsiChar;         // Pointer to dll name
   hmod:        NativeUInt;        // Address of module handle
   pIAT:        PImageThunkData;   // Address of the IAT
   pINT:        PImageThunkData;   // Address of the INT
   pBoundIAT:   PImageThunkData;   // Address of the optional bound IAT
   pUnloadIAT:  PImageThunkData;   // Address of optional copy of original IAT
   dwTimeStamp: LongWord;          // 0 if not bound, date/time stamp of DLL bound to (Old BIND)
  END;

  dliNotification = (
    dliNoteStartProcessing,        // used to bypass or note helper only
    dliNotePreLoadLibrary,         // called just before LoadLibrary, can override w/ new HMODULE return val
    dliNotePreGetProcAddress,      // called just before GetProcAddress, can override w/ new Proc address return value
    dliFailLoadLibrary,            // failed to load library, fix it by returning a valid HMODULE
    dliFailGetProcAddress,         // failed to get proc address, fix it by returning a valid Proc address
    dliNoteEndProcessing           // called after all processing is done, no bypass possible at this point except by exception
  );

  PDelayLoadProc = ^TDelayLoadProc;
  TDelayLoadProc = Record
   Case fImportByName: LongBool of
    False: (szProcName:   PAnsiChar);
    True:  (dwOrdinal:    LongWord);
  END;

  PDelayLoadInfo = ^TDelayLoadInfo;
  TDelayLoadInfo = Record
   cb:          LongWord;         // size of structure
   pidd:        PImageDelayDescr; // raw form of data (everything is there)
   ppfn:        Pointer;          // points to address of function to load
   szDll:       PANSIChar;        // name of dll
   dlp:         TDelayLoadProc;   // name or ordinal of procedure
   hmodCur:     NativeUInt;       // the hInstance of the library we have loaded
   pfnCur:      Pointer;          // the actual function that will be called
   dwLastError: LongWord;         // error received (if an error notification)
  END;

  TDelayedLoadHook = Function (dliNotify: dliNotification; pdli: PDelayLoadInfo): Pointer; StdCall;

  procedure ___pfnDliNotifyHook;
  procedure ___pfnDliFailureHook;
  procedure __delayLoadHelper;
  procedure __FUnloadDelayLoadedDLL;

  Var
   UnloadDelayLoadedDLLPtr: Pointer = @__FUnloadDelayLoadedDLL;
   DelayLoadHelper: Pointer = @__delayLoadHelper;
   pfnDliNotifyHook: Pointer = @___pfnDliNotifyHook;
   pfnDliFailureHook: Pointer = @___pfnDliFailureHook;

  Function SetDliNotifyHook(HookProc: TDelayedLoadHook): TDelayedLoadHook;
  Function DliNotifyHook: TDelayedLoadHook;

  Function SetDliFailureHook(HookProc: TDelayedLoadHook): TDelayedLoadHook;
  Function DliFailureHook: TDelayedLoadHook;

  // takes a pointer to a name to unload, or NULL to unload all the delay load dlls in the list.
  Procedure UnloadDelayLoadedDLL(szDll: PANSIChar); StdCall;
  Procedure _delayLoadHelper;
}
 Type RTLProc_LoadLibrary = Function (Const Filename: PChar): NativeUInt;
 Var LoadLibrary: RTLProc_LoadLibrary = NIL;

 Type RTLProc_LoadLibraryEx = Function(Const Filename: PChar; hFile: NativeUInt; dwFlags: Cardinal): NativeUInt;
 Var LoadLibraryEx: RTLProc_LoadLibraryEx = NIL;

 Type RTLProc_FreeLibrary = Function(hLibModule: NativeUInt): LongBool;
 Var FreeLibrary: RTLProc_FreeLibrary = NIL;

 Type RTLProc_FreeLibraryAndExitThread = Procedure(hLibModule: NativeUInt; dwExitCode: Cardinal);
 Var FreeLibraryAndExitThread: RTLProc_FreeLibraryAndExitThread = NIL;

 { Dummy symbol to fool the compiler }
 Type TInitContext = Pointer;

 //==================
 // RTL Extensions
 //==================
 Type
  TRTLEx_Modular_DLL = Record
   LoadLibrary: RTLProc_LoadLibrary;
   LoadLibraryEx: RTLProc_LoadLibraryEx;
   FreeLibrary: RTLProc_FreeLibrary;
   FreeLibraryAndExitThread: RTLProc_FreeLibraryAndExitThread;
  END;

 Procedure RTLExtend_Modular_DLL(Var Ex: TRTLEx_Modular_DLL);

{$ENDIF Include_Modules_Header}
(******************)
(* Implementation *)
(******************)
{$IFDEF Include_Modules_Implement}

 Const
  SEM_NOOPENFILEERRORBOX = $00008000;
  SEM_FAILCRITICALERRORS = $00000001;

 Function _INT_LoadLibrary(Const Filename: PChar; ErrorMode: Cardinal = SEM_NOOPENFILEERRORBOX OR SEM_FAILCRITICALERRORS): NativeUInt;
  Var
   OldErrMode: Cardinal;
   FPUControlWord: Word;
   LastError: Cardinal;
  BEGIN
   OldErrMode:= _WIN_SetErrorMode(ErrorMode);
   FPUControlWord:= Get8087CW;
   Try
    Result:= _WIN_LoadLibrary(Filename);
   Finally
    Set8087CW(FPUControlWord);

    LastError:= _WIN_GetLastError;
    _WIN_SetErrorMode(OldErrMode);
    _WIN_SetLastError(LastError);
   END;
  END;

 Function _INT_LoadLibraryEx(Const Filename: PChar; hFile: NativeUInt; dwFlags: Cardinal; ErrorMode: Cardinal = SEM_NOOPENFILEERRORBOX OR SEM_FAILCRITICALERRORS): NativeUInt;
  Var
   OldErrMode: Cardinal;
   FPUControlWord: Word;
   LastError: Cardinal;
  BEGIN
   OldErrMode:= _WIN_SetErrorMode(ErrorMode);
   FPUControlWord:= Get8087CW;
   Try
    Result:= _WIN_LoadLibraryEx(Filename, hFile, dwFlags);
   Finally
    Set8087CW(FPUControlWord);

    LastError:= _WIN_GetLastError;
    _WIN_SetErrorMode(OldErrMode);
    _WIN_SetLastError(LastError);
   END;
  END;

 Function _RTL_LoadLibrary(Const Filename: PChar): NativeUInt;
  BEGIN
   Result:= _INT_LoadLibrary(Filename);
  END;

 Function _RTL_LoadLibraryEx(Const Filename: PChar; hFile: NativeUInt; dwFlags: Cardinal): NativeUInt;
  BEGIN
   Result:= _INT_LoadLibraryEx(Filename, hFile, dwFlags);
  END;

 Function _RTL_FreeLibrary(hLibModule: NativeUInt): LongBool;
  BEGIN
   Result:= _WIN_FreeLibrary(hLibModule);
  END;

 Procedure _RTL_FreeLibraryAndExitThread(hLibModule: NativeUInt; dwExitCode: Cardinal);
  BEGIN
   _WIN_FreeLibraryAndExitThread(hLibModule, dwExitCode);
  END;

 //==================
 // RTL Extensions
 //==================

 Procedure RTLExtend_Modular_DLL(Var Ex: TRTLEx_Modular_DLL);
  BEGIN
   _INT_RTL_DoEx(@LoadLibrary, @Ex.LoadLibrary);
   _INT_RTL_DoEx(@LoadLibraryEx, @Ex.LoadLibraryEx);
   _INT_RTL_DoEx(@FreeLibrary, @Ex.FreeLibrary);
   _INT_RTL_DoEx(@FreeLibraryAndExitThread, @Ex.FreeLibraryAndExitThread);
  END;

 Procedure _INT_Modular_DLL_Init;
  BEGIN
   LoadLibrary:= _RTL_LoadLibrary;
   LoadLibraryEx:= _RTL_LoadLibraryEx;
   FreeLibrary:= _RTL_FreeLibrary;
   FreeLibraryAndExitThread:= _RTL_FreeLibraryAndExitThread;
  END;

{$ENDIF Include_Modules_Implement}
(******************)
(* Initialization *)
(******************)
{$IFDEF Include_Modules_Initialize}
{$ENDIF Include_Modules_Initialize}
(****************)
(* Finalization *)
(****************)
{$IFDEF Include_Modules_Finalize}
{$ENDIF Include_Modules_Finalize}
